home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
os2
/
srefv12i.zip
/
srefconf.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1997-03-04
|
73KB
|
2,300 lines
/* this the "simple" sre-filter configurator */
srefconf:
CHECKIT=0 /* Change this to 0 if you want to enable REMOTE configuration by SUPERUSERS */
/* the background color */
USECOLOR='3def5f'
/* ---------------- DO NOT MODIFY BELOW THIS LINE ------------------ */
parse arg ddir, tempfile, action,list,verb ,uri,user, ,
basedir ,workdir,privset,enmadd,transaction,verbose, ,
servername,host_nickname,homedir
if verb=" " then do
say "The SRE-Filter simple configurator is not meant to be run in standalone mode "
exit
end /* Do */
host_nickname=strip(upper(host_nickname))
call okay_client
if notokay=1 then return rstatus||' Simple Configurator: Client not allowed access '
optlist='ADD_HOST REMOVE_HOST CHECKLOG LOGON_FAIL_FILE ADD_USER REMOVE_USER '
OPTLIST=OPTLIST||' ADD_INHOUSE REMOVE_INHOUSE ALLOW_ACCESS DO_HTACCESS ACCESS_FAIL_FILE '
OPTLIST=OPTLIST||' ADD_ACESS REMOVE_ACCESS DEFAULT_ACCESS AUTO_NAME NOT_FOUND_URL '
OPTLIST=OPTLIST||' THE_REALM HOME_NAME HOME_DIR ADD_VIRTUAL REMOVE_VIRTUAL INDEX '
OPTLIST=OPTLIST||' WRITE_LOGS RECORD_OPTION HIT_CACHE_LEN HIT_OWNER_SUPPRESS ADD_ACCESS'
OPTLIST=OPTLIST||' SSI_SHTML_ONLY HEADERS WEBMASTER ADD_CUSTOM REMOVE_CUSTOM '
OPTLIST=OPTLIST||' NO_SS ADD_REDIRECT REMOVE_REDIRECT SSI_CACHE_ON '
OPTLIST=OPTLIST||' FIX_EXPIRE SMTP_GATEWAY ADD_PUBLICURL REMOVE_PUBLICURL '
/* intitialize possible arguments */
arglist.!show=0 ;arglist.!set=0
/* get argument list */
do until list=""
parse var list a1 '&' list
parse var a1 atype '=' aval ; aval=strip(aval); atype=upper(strip(atype))
foo='!'||atype
arglist.foo=aval
end /* do */
foo=sref_expire_response(-1) /* suppress immediate expire ? */
/* if SHOW argument, then return the appropriate request form */
if arglist.!show<>0 then do
ares=show_it(arglist.!show)
return ares
end /* Do */
/* if SET argument, then go make the change*/
if arglist.!set<>0 then do
ares=set_it(arglist.!set) /*expose arglist */
return ares
end /* Do */
'nodata'
return '400 0 Simple configurator '
/****************************/
/*Change a parameter */
/* based on stuff returned by client's response to show_it generated forms */
set_it:procedure expose ddir optlist verbose servername enmadd host_nickname basedir arglist. tempfile
parse upper arg theopt
ddir=strip(translate(ddir,'\','/'),'t','\')||'\'
crlf='0d0a'x
redo=1
initfile=get_value('initfilt_file')
workdata=get_value('workdata_dir')
if wordpos(theopt,optlist)=0 then do
foo=responsecf('badreq','Configure',' You selected an unknown parameter: '||theopt)
return 0
end
/* for each of the possible entries in optlist */
select
when theopt="CHECKLOG" then do
aval='YES'
if arglist.!yesno=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Client Logon Requirement','LOGON')
end
when theopt="LOGON_FAIL_FILE" then do
aval='LOGFAIL.HTM'
if arglist.!yesno=0 then aval='0'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Use Logon-Failure Response File ','LOGON')
end
when theopt="ALLOW_ACCESS" then do
aval='YES'
if arglist.!yesno=1 then aval='INHOUSE'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Check SEL-specific Access Controls ','ACCESS')
end
when theopt="DO_HTACCESS" then do
aval='YES'
if arglist.!yesno=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Enable HTACCESS Method','ACCESS')
end
when theopt="ACCESS_FAIL_FILE" then do
aval='ACCFAIL.HTM'
if arglist.!yesno=0 then aval='0'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Use Access-Failure Response File ','ACCESS')
end
when theopt="THE_REALM" then do
aval=arglist.!thevalue
aval=translate(aval,' ','+'||'00090a0d'x)
aval=packur(aval)
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Default Realm ','NAMES')
end
when theopt="HOME_NAME" then do
aval=arglist.!thevalue
aval=translate(aval,' ','+'||'00090a0d'x)
aval=packur(aval)
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Colloquial Name of Site ','NAMES')
end
when theopt="INDEX" then do
aval=arglist.!thevalue
if upper(aval)="OTHER" then aval=arglist.!ownvalue
aval=packur(aval)
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Default Document ','DEFAULT')
end
when theopt="AUTO_NAME" then do
mkit=" "
if symbol('arglist.!thevalue1')='VAR' then mkit=mkit||' INDEX.HTM '
if symbol('arglist.!thevalue2')='VAR' then mkit=mkit||' INDEX.HTML '
if symbol('arglist.!thevalue3')='VAR' then mkit=mkit||' *.HTM '
if symbol('arglist.!thevalue4')='VAR' then mkit=mkit||' *.HTML '
if symbol('arglist.!thevalue5')='VAR' then do
foo=translate(arglist.!thevalue5,' ','+')
mkit=mkit||' '||foo
end
if symbol('arglist.!thevalue6')='VAR' then mkit=mkit||' !DIR '
if symbol('arglist.!thevalue6a')='VAR' then do /* autodesecirbe */
diro=get_value('DIR_OPTIONS')
oo="" ; gota=0
do until diro=""
parse var diro v1 diro
if abbrev(upper(v1),'AUTO_DESCRIBE')=1 then do
oo=oo||' '||'AUTO_DESCRIBE='||arglist.!thevalue6a||' '
gota=1
end
else do
oo=oo||' '||v1
end
end
if gota=0 then do
oo=oo||' '||'AUTO_DESCRIBE='||arglist.!thevalue6a||' '
end /* Do */
end /* do */
foo=change_initfilt(theopt,mkit)
foo=change_initfilt('DIR_OPTIONS',oo)
wow=change_okay(foo,' Directory Specific Default Document ','DIRS')
end
when theopt="NOT_FOUND_URL" then do
aval=arglist.!thevalue
aval=translate(aval,' ','+'||'00090a0d'x)
aval=packur(aval)
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Not Found Document Response ','DEFAULT')
end
when theopt="HOME_DIR" then do
aval=arglist.!thevalue
aval=translate(aval,' ','+'||'00090a0d'x)
aval2=arglist.!thevalue2
aval2=translate(aval2,' ','+'||'00090a0d')
if aval2=' ' then do
mkit=aval
end
else do
mkit=translate(aval,'/','\')
mkit=strip(aval,'t','/')||'/$/'
AVAL2=translate(aval2,'/','\')
mkit=mkit||strip(aval2,'l','/')
end /* Do */
foo=change_initfilt(theopt,mkit)
wow=change_okay(foo,'Home Directory','DIRS')
end
when theopt="RECORD_OPTION" then do
aval='YES'
if arglist.!record=2 then aval='FILE'
if arglist.!record=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Recording option ','RECORD')
end
when theopt="HIT_CACHE_LEN" then do
aval='5'
if arglist.!yesno=0 then aval=0
if arglist.!yesno=2 then aval='FILE'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Type of Repetitive Hits Cache','RECORD')
end
when theopt="HIT_OWNER_SUPPRESS" then do
aval='YES'
if arglist.!yesno=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Suppress Recording OWNER Requests','RECORD')
end
when theopt="WRITE_LOGS" then do
aval='YES'
if arglist.!yesno=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Enable Common-Log Audit File','RECORD')
end
when theopt="SSI_SHTML_ONLY" then do
aval='YES'
if arglist.!yesno=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'SSI on SHTML Only','SSI')
end
when theopt="SSI_CACHE_ON" then do
aval='YES'
if arglist.!yesno=0 then aval='NO'
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'SSI CACHE Enable','SSI')
end
when theopt="WEBMASTER" then do
aval=arglist.!thevalue
aval=translate(aval,' ','+'||'00090a0d'x)
aval=packur(aval)
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'WEBMASTER ','SSI')
end
when theopt="FIX_EXPIRE" then do
aval='0.05'
if arglist.!yesno=0 then aval=0
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'Suppress Immediate Expiration','MISC')
end
when theopt="NO_SS" then do
no_ssi='NO'
if arglist.!no_ssi then no_ssi='YES'
no_proc='NO' ; no_code='NO'
if arglist.!no_ssp=1 then no_proc='YES'
if arglist.!no_ssp=11 then no_code='YES'
foo1=change_initfilt('NO_INCLUDE',no_ssi)
foo2=change_initfilt('NO_PROCESSING',no_proc,1)
foo=change_initfilt('NO_INTERPRET_CODE',no_code,1)
wow=change_okay(foo,'Suppress SSP and SSI ','MISC')
end /* Do */
when theopt="SMTP_GATEWAY" then do
aval=arglist.!thevalue
aval=translate(aval,' ','+'||'00090a0d'x)
aval=packur(word(aval,1))
foo=change_initfilt(theopt,aval)
wow=change_okay(foo,'SMTP_GATEWAY ','MISC')
end
when theopt="HEADERS" then do
/* sepearte at crlfs */
ahead=packur(translate(arglist.!header,' ','+'))
afoot=packur(translate(arglist.!footer,' ','+'))
nhead=0
do until ahead=""
parse var ahead aline (crlf) ahead ;
aline=strip(translate(aline,' ','000d0a'x))
if aline="" then iterate
nhead=nhead+1
headers.nhead=aline
end /* do */
nfoot=0
do until afoot=""
parse var afoot aline (crlf) afoot
aline=strip(translate(aline,' ','000d0a'x))
if aline="" then iterate
nfoot=nfoot+1
footers.nfoot=aline
end /* do */
if nhead>0 then do
foo1=change_initfilt('HEADERS.1',headers.1)
do mm=2 to nhead
foo1=change_initfilt('HEADERS.'||mm,headers.mm,1)
end /* do */
nhead=nhead+1
foo=change_initfilt('HEADERS.'||nhead,0,1)
end
else do
nhead=1
foo=change_initfilt('HEADERS.1',0)
end
/* trash old headers */
foo1='1' ; joe=nhead
do until foo1<>'1'
joe=joe+1
foo1=change_initfilt('HEADERS.'||joe,,,1)
end /* do */
if nFOOT>0 then do
foo1=change_initfilt('FOOTERS.1',FOOTers.1,1)
do mm=2 to nFOOT
foo1=change_initfilt('FOOTERS.'||mm,FOOTers.mm,1)
end /* do */
nfoot=nfoot+1
foo=change_initfilt('FOOTERS.'||nFOOT,0,1)
end
else do
nfoot=1
foo=change_initfilt('FOOTERS.1',0,1)
end
foo1='1' ; joe=nfoot /* remove old footers */
do until foo1<>'1'
joe=joe+1
foo1=change_initfilt('FOOTERS.'||joe,,,1)
end /* do */
wow=change_okay(foo,'HEADER and FOOTER ','SSI')
end /* Do */
when theopt="ADD_INHOUSE" then do
foo=strip(translate(arglist.!user,' ','+'))
foo2=strip(translate(arglist.!privs,' ','+'))
aval=word(foo,1)||' '||foo2
foo=change_stem('INHOUSEIPS.',aval)
wow=change_okay(foo,'Add an In-House User','LOGON')
end /* Do */
when theopt="ADD_HOST" then do
foo=strip(translate(arglist.!host,' ','+'))
foo2=strip(translate(arglist.!nickname,' ','+'))
foo3=packur(strip(translate(arglist.!datadir,' ','+')))
aval=word(foo,1)||', '||word(foo2,1)||', '||word(foo3,1)
foo=change_stem('HOSTS.',upper(aval))
wow=change_okay(foo,'Add a Host Identification','HOST')
end /* Do */
when theopt="REMOVE_INHOUSE" then do
remlist=make_removes()
foo=change_stem('INHOUSEIPS.',,upper(remlist))
foo1='1' ; joe=nkill /* remove old footers */
do until foo1<>'1'
joe=joe+1
foo1=change_initfilt('INHOUSEIPS.'||joe,,,1)
end /* do */
wow=change_okay(foo,'Remove In-House Users','LOGON',mess2)
end /* Do */
when theopt="ADD_PUBLICURL" then do
foo=strip(translate(arglist.!url,' ','+'))
isliteral=0 ; norecord=0
if symbol('ARGLIST.!LITERAL')='VAR' then
isliteral=arglist.!literal
if symbol('ARGLIST.!NORECORD')='VAR' then
norecord=arglist.!norecord
select
when isliteral=1 & norecord=1 then foo2='LITERAL_NORECORD'
when isliteral=1 then foo2='LITERAL'
when norecord=1 then foo2='NORECORD'
otherwise foo2=' '
end
aval=word(foo,1)||' '||foo2
foo=change_stem('PUBLIC_URLS.',aval)
wow=change_okay(foo,'Add PUBLIC Area Identifier','PUBLICURL')
end /* Do */
when theopt="REMOVE_PUBLICURL" then do
remlist=make_removes()
foo=change_stem('PUBLIC_URLS.',,upper(remlist))
foo1='1' ; joe=inlist /* remove old footers */
do until foo1<>'1'
joe=joe+1
foo1=change_initfilt('PUBLIC_URLS.'||joe,,,1)
end /* do */
wow=change_okay(foo,'Remove PUBLIC Areas Identifier','PUBLICURL',mess2)
end /* Do */
when theopt="REMOVE_HOST" then do
remlist=make_removes()
foo=change_stem('HOSTS.',,upper(remlist))
wow=change_okay(foo,'Remove Host Identification Entries','HOST',mess2)
end /* Do */
when theopt="ADD_USER" then do
foo1=translate(upper(strip(arglist.!user)),' ','+')
foo1=word(foo1,1)
foo2=translate(upper(strip(arglist.!pwd)),' ','+')
foo2=word(foo2,1)
foo3=translate(upper(strip(arglist.!privs)),' ','+')
if foo3=' 'then foo3='NEWUSER'
aval=foo1' 'foo2' 'foo3
foo=change_file('USER_FILE',aval)
wow=change_okay(foo,'Add Users','LOGON')
end /* Do */
when theopt="REMOVE_USER" then do
remlist=make_removes()
foo=change_file('USER_FILE',,upper(remlist))
wow=change_okay(foo,'Remove Users','LOGON',mess2)
end /* Do */
when theopt="ADD_ACCESS" then do
plist=' '
tenp='NO_SSI NO_CODE NO_SSP CACHE PUT DELETE NO_HTACCESS NO_VIRTUAL NO_ALIAS NO_POSTFILTER'
do po=1 to 10
axx=strip(word(tenp,po))
if symbol('ARGLIST.!'||axx)="VAR" then do
plist=plist||' '||axx
end /* Do */
end /* do */
foo1=translate(upper(strip(arglist.!url)),' ','+')
foo1=word(foo1,1)
foo2=translate(upper(strip(arglist.!privs)),' ','+')
if foo2=' ' then foo2='*'
foo3=translate(upper(strip(arglist.!realm)),' ','+')
foo4=translate(upper(strip(arglist.!failfile)),' ','+')
aval=foo1' 'foo2' , ' plist ' , 'foo3' , ' foo4
foo=change_file('ACCESS_FILE',aval)
wow=change_okay(foo,'Add Access Control Entry','ACCESS')
end /* Do */
when theopt="DEFAULT_ACCESS" then do
foo1=translate(upper(strip(arglist.!defprivs)),' ','+')
if foo1=' ' then foo1='*'
aval='/* '||foo1
foo=change_file('ACCESS_FILE',aval,'/* ')
wow=change_okay(foo,'Change Default Access Control Entry','ACCESS')
end /* Do */
when theopt="REMOVE_ACCESS" then do
remlist=make_removes()
foo=change_file('ACCESS_FILE',,upper(remlist))
wow=change_okay(foo,'Remove Access Control Entry','ACCESS',mess2)
end
when theopt="ADD_VIRTUAL" then do
foo1=translate(upper(strip(arglist.!url)),' ','+')
foo1=word(foo1,1)
foo2=translate(upper(strip(arglist.!directory)),' ','+')
foo2=word(foo2,1)
foo2=translate(foo2,'\','/')
foo2=strip(foo2,'t','\')||'\* '
aval=foo1' 'foo2
foo=change_file('VIRTUAL_FILE',aval,,,1)
wow=change_okay(foo,'Add Virtual Directory Entry','DIRS')
end
when theopt="REMOVE_VIRTUAL" then do
remlist=make_removes()
foo=change_file('VIRTUAL_FILE',,upper(remlist))
wow=change_okay(foo,'Remove Virtual Directory Entry','DIRS',mess2)
end
when theopt="ADD_REDIRECT" then do
foo1=translate(upper(strip(arglist.!url)),' ','+')
foo1=word(foo1,1)
foo2=translate(strip(arglist.!newurl),' ','+')
foo2=word(foo2,1)
aval=foo1' 'foo2
foo=change_file('ALIAS_FILE',aval)
wow=change_okay(foo,'Add Redirection Alias Entry','DIRS')
end
when theopt="REMOVE_REDIRECT" then do
remlist=make_removes()
foo=change_file('ALIAS_FILE',,upper(remlist))
wow=change_okay(foo,'Remove Redirection Alias Entry','DIRS',mess2)
end
when theopt="ADD_CUSTOM" then do
foo1=translate(upper(strip(arglist.!variable)),' ','+')
foo1=word(foo1,1)
foo2=packur(translate(strip(arglist.!value),' ','+'))
if host_nickname<>' ' then foo1=foo1||'.'||host_nickname
aval=foo1' 'foo2
took=host_nickname
host_nickname=' '
foo=change_file('REPSTRGS_FILE',aval)
host_nickname=took
wow=change_okay(foo,'Add Custom Replacement Variable','SSI')
end
when theopt="REMOVE_CUSTOM" then do
remlist=make_removes()
took=host_nickname
if host_nickname<>' ' then do
arf=""
do until remlist=""
parse var remlist a1 remlist
a1=strip(a1)||'.'||host_nickname||' '
end
remlist=a1
end /* do */
host_nickname=' '
foo=change_file('REPSTRGS_FILE',,upper(remlist),,,1)
host_nickname=took
wow=change_okay(foo,'Remove Redirection Alias Entry','SSI',mess2)
end
otherwise do
string ' Modification n.a. for ' theopt
redo=0 ; wow='200 40 '
end
end /* select */
/* signal srefmon to refresh values ? */
if redo=1 then foo=value('SREF_REDO',1,'os2environment')
return wow
/****************************/
/* make a "removes" list from arglist.!delete.n entres */
make_removes:procedure expose arglist.
ndo=arglist.!entries
arf=""
do mm =1 to ndo
aa='!DELETE.'||mm
oo=symbol('ARGLIST.'||aa)
if oo<>'VAR' then iterate
arf=arf||' '||arglist.aa
end
return arf
/****************************/
/* modify a parameter in the initfilt file */
change_initfilt:procedure expose verbose servername enmadd host_nickname basedir initfile
parse arg aopt,aval0,noupdate,noadd
aopt=strip(upper(aopt)); aval0=strip(aval0)
if noupdate=' ' then noupdate=0
if noadd=' ' then noadd=0
foo=fileread(initfile,dalines,,'E')
if dalines.0=0 then return 'Could not read:'||initfile
aval0=sref_replacestrg(aval0,"'","''",'ALL')
foundit=0
/* scan through, looking for parameter that matches aopt.
Also, must be same host nickname. Retain all non matches in
same order. If match, delete, and rewrite at end of file.
Copy old file to xxx.BAK (overwrite old xxx.bak if it exists) */
inew=0
do mm=1 to dalines.0
aline=strip(upper(dalines.mm))
if aline=" " | abbrev(aline,';')=1 then do /* retain comments */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
if abbrev(aline,aopt)=0 then do /* non match, retain */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
/* correct name, but is it correct host */
parse var aline avar '=' aval
avar=translate(avar,' ','.')
nw=words(avar)
if host_nickname<>' ' then do /* see if it matches this host nickname */
if nw=1 then do /* no host nickname, can't match */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
if strip(upper(word(avar,nw)))<>host_nickname then do /* does not match this host */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
end
else do /* generic site */
if nw>1 & datatype(word(avar,nw))<>'NUM' then do /* host specific parameter */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
end
/* if here, a match. so skip it (and rewrite at end of list */
foundit=1
end
/* if nosuch paramter, and noadd mode, return */
if noadd=1 & foundit=0 then return 0 /* signal no more */
if noadd=0 then do /* add new value, if noadd=0 */
inew=inew+1
if host_nickname<>' ' then
isvar=aopt||'.'||host_nickname
else
isvar=aopt
newlines.inew=isvar||"='"||aval0||"'"
end
newlines.0=inew
if noupdate<>1 then do
bakfile=initfile /* create a .bak file */
foo=lastpos('.',bakfile)
if foo=0 then
bakfile=bakfile||'.bak'
else
bakfile=delstr(bakfile,foo)||'.bak'
wow=doscopy(initfile,bakfile,'R')
if wow<>0 then do
say " ERROR: backup copy could not be made, error code " wow
return 'Backup copy could not be made'
end /* Do */
end
/* now write new results */
foo=filewrite(initfile,newlines,'R')
if foo=0 then return 'Could not save parameters file '
return 1 /* success */
/****************************/
/* modify a parameter in the initfilt file */
change_stem:procedure expose verbose servername enmadd host_nickname basedir initfile mess2 inlist nkill
parse arg lookfor, newval,remlist
foo=fileread(initfile,dalines,,'E')
if dalines.0=0 then return 'Could not read:'||initfile
nkill=0
/* scan through, looking for inhouseips or other stem parameters,
of the appropriate host. Pull them, and add or remove
*/
inew=0
ninh=0
do mm=1 to dalines.0
aline=strip(upper(dalines.mm))
if aline=" " | abbrev(aline,';')=1 then do /* retain comments */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
if abbrev(aline,lookfor)=0 then do /* non match, retain */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
/* correct name, but is it correct host */
parse var aline avar '=' aval
avar=translate(avar,' ','.')
nw=words(avar)
if host_nickname<>' ' then do /* see if it matches this host nickname */
if strip(upper(word(avar,nw)))<>host_nickname then do /* does not match this host */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
end
else do /* generic site */
if datatype(word(avar,nw))<>'NUM' then do /* host specific parameter */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
end
/* if here, a match. If remlist=' ', then temp record and skip it (and rewrite at end of list
of remlist<>' ', then keep only if not in remlist */
aval=strip(strip(aval),,'"')
aval=strip(aval,,"'")
if aval=0 | aval=" " then iterate /* ignore end flags */
if remlist<>' ' then do
w1=upper(strip(word(translate(aval,' ',','),1)))
if wordpos(w1,remlist)>0 then do
nkill=nkill+1
iterate
end /* Do */
end
ninh=ninh+1 /* else, keep it*/
inhs.ninh=aval
end
if newval<>' ' then do /* add the new one */
ninh=ninh+1
inhs.ninh=newval
end
/* fix up form to save */
do ii=1 to ninh
if host_nickname<>' ' then do
bval=inhs.ii
inhs.ii=lookfor||ii||'.'||host_nickname||"='"||bval||"'"
end /* do */
else do
bval=inhs.ii
inhs.ii=lookfor||ii||"='"||bval||"'"
end /* Do */
end
ninh=ninh+1
if host_nickname<>' ' then do
inhs.ninh=lookfor||host_nickname||'.'||ninh||'=0'
end
else do
inhs.ninh=lookfor||ninh||'=0'
end
do mm=1 to ninh
inew=inew+1
newlines.inew=inhs.mm
end /* do */
newlines.0=inew
if noupdate<>1 then do
bakfile=initfile /* create a .bak file */
foo=lastpos('.',bakfile)
if foo=0 then
bakfile=bakfile||'.bak'
else
bakfile=delstr(bakfile,foo)||'.bak'
wow=doscopy(initfile,bakfile,'R')
if wow<>0 then do
say " ERROR: backup copy could not be made, error code " wow
return 'Backup copy could not be made'
end /* Do */
end
/* now write new results */
foo=filewrite(initfile,newlines,'R')
if foo=0 then return 'Could not save parameters file '
mess2=' Number entries deleted: '||nkill
inlist=ninh
return 1 /* success */
/****************************/
/* tell client status of parameter change */
change_okay:procedure expose tempfile
parse arg status,whatis,jumpto,mess2
if status<>1 then
text='Problem modifying: '||whatis
else
text='Success modifying: '||whatis
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>"text"</title></head><body>"
if status=1 then do
call lineout tempfile,' <h2> ' whatis ' successfully modified </h2> '
call lineout tempfile,' Modification will take effect in approximately 15 seconds '
if mess2<>' ' then call lineout tempfile,'<br> <em> ' mess2 '</em> '
end
else do
call lineout tempfile,' <h2>Sorry, ' whatis ' could not be modified </h2> '
call lineout tempfile,' Problem: ' status
end
call lineout tempfile,'<hr> <a href="/config0.htm#'jumpto'">Return to simple configurator </a>'
call lineout tempfile, '</body><html>'
call lineout tempfile
oof=dosdir(tempfile,'s')
'FILE ERASE TYPE text/html NAME ' tempfile
return '200 '||oof
/****************************/
/* Load, modify, and return a parameter modification form */
/* uses templates in the config_dir directory */
show_it:procedure expose ddir optlist verbose servername enmadd host_nickname basedir tempfile usecolor
parse upper arg theopt
crlf='0d0a'x
ok=0
ddir=strip(translate(ddir,'\','/'),'t','\')||'\'
workdata=get_value('workdata_dir')
thedir=get_value('CONFIG_DIR')
if thedir=' ' then
thedir=ddir||'CONFIGS'
if dosisdir(thedir)=0 then do
'STRING Bad Setup: no CONFIG_DIR directory: ' thedir
return 0
end /* Do */
if wordpos(theopt,optlist)=0 then do
foo=responsecf('badreq','Configure',' You selected an unknown parameter ')
return 0
end */
/* grab a file, and modify it, based on theopt */
select
when theopt='ADD_HOST' then do
ok=GET_IT('ADDHOST')
ok=make_doc(theopt,1,'HOST')
end
when theopt='REMOVE_HOST' then do
ok=GET_IT('REMHOST')
foo=make_hosts('initfilt_file')
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('initfilt_file')
stuff=a_replacestrg(stuff,'$initfilt_file',foo,'ALL')
ok=make_doc(theopt,1,'HOST')
end
when theopt='CHECKLOG' then do
ok=GET_IT('CHECKLOG')
ok=do_yesno('CHECKLOG','N','YES Y 1 ALWAYS INHOUSE ')
ok=make_doc(theopt,0,'LOGON')
end
when theopt='LOGON_FAIL_FILE' then do
ok=GET_IT('LOGFAIL')
ok=do_yesno('LOGON_FAIL_FILE','Y')
stuff=a_replacestrg(stuff,'$SERVDIR',basedir,'ALL')
ok=make_doc(theopt,0,'LOGON')
end
when theopt='ADD_USER' then do
ok=GET_IT('ADDUSER')
foo=get_value('USER_FILE')
stuff=a_replacestrg(stuff,'$USER_FILE',foo,'ALL')
ok=make_doc(theopt,0,'LOGON')
end
when theopt='REMOVE_USER' then do
ok=GET_IT('REMUSER')
foo=make_users('USER_FILE')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('user_file')
stuff=a_replacestrg(stuff,'$user_file',foo,'ALL')
ok=make_doc(theopt,0,'LOGON')
end
when theopt='ADD_INHOUSE' then do
ok=GET_IT('ADDINH')
foo=get_value('USER_FILE')
stuff=a_replacestrg(stuff,'$USER_FILE',foo,'ALL')
ok=make_doc(theopt,0,'LOGON')
end
when theopt='REMOVE_INHOUSE' then do
ok=GET_IT('REMINH')
foo=make_inhouseips('initfilt_file')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('initfilt_file')
stuff=a_replacestrg(stuff,'$initfilt_file',foo,'ALL')
ok=make_doc(theopt,0,'LOGON')
end
when theopt='ADD_PUBLICURL' then do
ok=GET_IT('ADDPURL')
stuff=a_replacestrg(stuff,'$DATADIR',ddir,'ALL')
foo=get_value('initfilt_file')
stuff=a_replacestrg(stuff,'$initfilt_file',foo,'ALL')
stuff=a_replacestrg(stuff,'$DATADIR',ddir,'ALL')
ok=make_doc(theopt,0,'PUBLICURL')
end
when theopt='REMOVE_PUBLICURL' then do
ok=GET_IT('REMPURL')
foo=make_puburls('initfilt_file')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('initfilt_file')
stuff=a_replacestrg(stuff,'$initfilt_file',foo,'ALL')
ok=make_doc(theopt,0,'PUBLICURL')
end
when theopt='ALLOW_ACCESS' then do
ok=GET_IT('ALLOWAC')
ok=do_yesno('ALLOW_ACCESS','Y','Y YES 1 INHOUSE ')
ok=make_doc(theopt,0,'ACCESS')
end
when theopt='DO_HTACCESS' then do
ok=GET_IT('HTACCESS')
ok=do_yesno('DO_HTACCESS','N')
ok=make_doc(theopt,0,'ACCESS')
end
when theopt='ACCESS_FAIL_FILE' then do
ok=GET_IT('ACCFAIL')
ok=do_yesno('ACCESS_FAIL_FILE','Y')
stuff=a_replacestrg(stuff,'$SERVDIR',basedir,'ALL')
ok=make_doc(theopt,0,'ACCESS')
end
when theopt='ADD_ACCESS' then do
ok=GET_IT('ADDACC')
foo=get_value('ACCESS_FILE')
stuff=a_replacestrg(stuff,'$ACCESS_FILE',foo,'ALL')
ok=make_doc(theopt,0,'ACCESS')
end
when theopt='REMOVE_ACCESS' then do
ok=GET_IT('REMACC')
foo=make_access('ACCESS_FILE')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('access_file')
stuff=a_replacestrg(stuff,'$ACCESS_FILE',foo,'ALL')
ok=make_doc(theopt,0,'ACCESS')
end
when theopt='DEFAULT_ACCESS' then do
ok=GET_IT('DEFACC')
foo=make_access('ACCESS_FILE',1)
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$default_access',stuff2,'ALL')
foo=get_value('access_file')
stuff=a_replacestrg(stuff,'$ACCESS_FILE',foo,'ALL')
ok=make_doc(theopt,0,'ACCESS')
end
WHEN THEOPT="INDEX" then DO
ok=get_it('DEFAULT')
adef=strip(upper(get_value('DEFAULT')))
select
when adef="INDEX.HTM" then do
adef1='CHECKED' ; adef2=' ' ; adef3=' ' ;afile=' '
end /* Do */
when adef="INDEX.HTML" then do
adef1=' ' ; adef2='CHECKED' ; adef3=' '; afile=' '
end /* Do */
otherwise do
adef1=' ' ; adef2=' ' ; adef3='CHECKED' ; afile=adef
end
end
stuff=a_replacestrg(stuff,'$HTMINDEX',adef1,'ALL')
stuff=a_replacestrg(stuff,'$HTMLINDEX',adef2,'ALL')
stuff=a_replacestrg(stuff,'$INDEXOTHER',adef3,'ALL')
stuff=a_replacestrg(stuff,'$INDEXfile',afile,'ALL')
stuff=a_replacestrg(stuff,'$DATADIR',ddir,'ALL')
ok=make_doc(theopt,0,'DEFAULT')
end /* Do */
when theopt='AUTO_NAME' then do
ok=get_it('autoname')
adef=strip(upper(get_value('AUTO_NAME')))
oks='INDEX.HTM INDEX.HTML *.HTM *.HTML !CREATE !DIR'
oks2='$htmindex $htmlindex $htmdirname $htmldirname $createdir $dir_dir '
other=""
do mm=1 to words(oks)
a1=strip(word(oks,mm))
ado=strip(word(oks2,mm))
tt=wordpos(a1,adef)
if tt=0 then do
adef1=' '
end
else do
adef1='checked'
adef=delword(adef,tt,1)
end
stuff=a_replacestrg(stuff,ado,adef1,'ALL')
end
stuff=a_replacestrg(stuff,'$other',adef,'ALL')
ok=strip(upper(get_value('DIR_OPTIONS')))
autodno='checked' ; autodyes=' '
if (wordpos('AUTO_DESCRIBE',ok)+wordpos('AUTO_DESCRIBE=1',ok))>0 then do
autodno=' '; autodyes='checked';
end
stuff=a_replacestrg(stuff,'$AUTODNO',autodno,'ALL')
stuff=a_replacestrg(stuff,'$AUTODYES',autodyes,'ALL')
ok=make_doc(theopt,0,'DEFAULT')
end
when theopt='NOT_FOUND_URL' then do
ok=GET_IT('notfound')
tt=get_value('NOT_FOUND_URL')
tt=a_replacestrg(tt,'<','<','ALL')
tt=a_replacestrg(tt,'>','>','ALL')
tt=a_replacestrg(tt,'"','"','ALL')
stuff=a_replacestrg(stuff,'$not_found_url',tt,'ALL')
ok=make_doc(theopt,0,'DEFAULT')
end
when theopt='THE_REALM' then do
ok=GET_IT('realmnam')
tt=get_value('THE_REALM')
stuff=a_replacestrg(stuff,'$therealm',tt,'ALL')
ok=make_doc(theopt,0,'NAMES')
end
when theopt='HOME_NAME' then do
ok=GET_IT('homename')
tt=get_value('HOME_NAME')
stuff=a_replacestrg(stuff,'$home_name',tt,'ALL')
ok=make_doc(theopt,0,'NAMES')
end
when theopt='HOME_DIR' then do
ok=GET_IT('homedir')
tt=get_value('HOME_DIR',0,'DIRS')
ms=pos('$',tt)
if ms=0 then do
hd1=tt ; hd2=' '
end /* Do */
else do
hd1=substr(tt,1,ms-1) ;hd2=substr(tt,ms+2)
end /* Do */
stuff=a_replacestrg(stuff,'$home_DIR',hd1,'ALL')
stuff=a_replacestrg(stuff,'$home_subDIR',hd2,'ALL')
ok=make_doc(theopt,0,'DIRS')
end
when theopt='ADD_VIRTUAL' then do
ok=GET_IT('ADDVIRT')
foo=get_value('VIRTUAL_FILE')
stuff=a_replacestrg(stuff,'$VIRTUAL_FILE',foo,'ALL')
stuff=a_replacestrg(stuff,'$DATADIR',ddir,'ALL')
stuff=a_replacestrg(stuff,'$SERVDrive',filespec('d',basedir),'ALL')
stuff=a_replacestrg(stuff,'$SERVDir',basedir,'ALL')
foo=get_value('CGI_BIN_DIR')
stuff=a_replacestrg(stuff,'$cgi_bin_dir',foo,'ALL')
foo=get_value('UPLOAD_DIR')
stuff=a_replacestrg(stuff,'$upload_dir',foo,'ALL')
ok=make_doc(theopt,0,'DIRS')
end
when theopt='REMOVE_VIRTUAL' then do
ok=GET_IT('REMVIRT')
foo=make_virtual('VIRTUAL_FILE')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('virtual_file')
stuff=a_replacestrg(stuff,'$virtual_file',foo,'ALL')
stuff=a_replacestrg(stuff,'$DATADIR',ddir,'ALL')
stuff=a_replacestrg(stuff,'$SERVDrive',filespec('d',basedir),'ALL')
ok=make_doc(theopt,0,'DIRS')
end
when theopt='RECORD_OPTION' then do
ok=GET_IT('RECORD')
tt=strip(upper(get_value('RECORD_OPTION')))
fil=get_value('RECORD_ALL_FILE')
stuff=a_replacestrg(stuff,'$record_all_file',fil,'ALL')
isno='checked' ; isyes=' '; isurl=' '
if tt="YES" | tt="YES_ALL" then do
isno=' '; isyes='checked'
end /* Do */
if tt='FILE' then do
isno=' '; isfile='checked'
end /* Do */
stuff=a_replacestrg(stuff,'$isurl',isyes,'ALL')
stuff=a_replacestrg(stuff,'$isno',isno,'ALL')
stuff=a_replacestrg(stuff,'$isfile',isfile,'ALL')
ok=make_doc(theopt,0,'RECORD')
end
when theopt='HIT_CACHE_LEN' then do
ok=get_it('HITLEN')
foo=upper(strip(get_value('HIT_CACHE_LEN')))
issmall=' '; isno='checked' ; isbig=' '
if foo='FILE' then do
isbig='CHECKED' ;isno=' '
end /* Do */
if datatype(foo)="NUM" then do
if foo>0 then do
issmall='checked' ;isno=' '
end /* Do */
end /* Do */
stuff=a_replacestrg(stuff,'$isno',isno,'ALL')
stuff=a_replacestrg(stuff,'$issmall',issmall,'ALL')
stuff=a_replacestrg(stuff,'$isbig',isbig,'ALL')
ok=make_doc(theopt,0,'RECORD')
end
when theopt='HIT_OWNER_SUPPRESS' then do
ok=get_it('HITOWNER')
ok=do_yesno('HIT_OWNER_SUPPRESS','Y')
hm=get_value('OWNERS')
stuff=a_replacestrg(stuff,'$owners',hm,'ALL')
ok=make_doc(theopt,0,'RECORD')
end
when theopt='WRITE_LOGS' then do
ok=get_it('WRITELOG')
ok=do_yesno('WRITE_LOGS','Y')
stuff=a_replacestrg(stuff,'$workdata',workdata,'ALL')
ok=make_doc(theopt,0,'RECORD')
end
when theopt='SSI_SHTML_ONLY' then do
ok=get_it('SHTML')
ok=do_yesno('SSI_SHTML_ONLY','Y')
hm=get_value('SSI_EXTENSIONS')
stuff=a_replacestrg(stuff,'$ssi_extensions',hm,'ALL')
ok=make_doc(theopt,0,'SSI')
end
when theopt='SSI_CACHE_ON' then do
ok=get_it('SSICACHE')
ok=do_yesno('SSI_CACHE_ON','Y')
hm=get_value('SSI_CACHE_SIZE')
stuff=a_replacestrg(stuff,'$ssi_cache_size',hm,'ALL')
ok=make_doc(theopt,0,'SSI')
end
when theopt='HEADERS' then do
ok=get_it('header')
hd=strip(get_value('headers'))
ft=strip(get_value('footers'))
hd=strip(hd,'t','0')
ft=strip(ft,'t','0')
stuff=a_replacestrg(stuff,'$HD',hd,'ALL')
stuff=a_replacestrg(stuff,'$FT',FT,'ALL')
ok=make_doc(theopt,0,'SSI')
end
when theopt='WEBMASTER' then do
ok=get_it('WEBMASTR')
p2=get_value('WEBMASTER')
p2=a_replacestrg(p2,'<','<','ALL')
p2=a_replacestrg(p2,'>','>','ALL')
p2=a_replacestrg(p2,'"','"','ALL')
stuff=a_replacestrg(stuff,'$webmaster',p2,'ALL')
ok=make_doc(theopt,0,'SSI')
end
when theopt='ADD_CUSTOM' then do
ok=get_it('addcust')
foo=get_value('REPSTRGS_FILE')
stuff=a_replacestrg(stuff,'$REPLACE_FILE',foo,'ALL')
ok=make_doc(theopt,0,'SSI')
end
when theopt='REMOVE_CUSTOM' then do
ok=get_it('remcust')
foo=make_custom('repstrgs_file')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
ok=make_doc(theopt,0,'SSI')
end
when theopt='ADD_REDIRECT' then do
ok=GET_IT('ADDALIAS')
foo=get_value('ALIAS_FILE')
stuff=a_replacestrg(stuff,'$ALIAS_FILE',foo,'ALL')
ok=make_doc(theopt,0,'DIR')
end
when theopt='REMOVE_REDIRECT' then do
ok=GET_IT('REMAlias')
foo=make_alias('alias_file')
if foo=0 then return 0
stuff=a_replacestrg(stuff,'$table',stuff2,'ALL')
foo=get_value('alias_file')
stuff=a_replacestrg(stuff,'$alias_file',foo,'ALL')
ok=make_doc(theopt,0,'DIR')
end
when theopt='NO_SS' then do
ok=GET_IT('noss')
ok=do_yesno('NO_INCLUDE','N')
tssp=get_value('NO_PROCESSING')
tint=get_value('NO_INTERPRET_code')
okssp=' '; nossp=' ' ; noint=' '
if tssp=0 & tint=0 then do
okssp='CHECKED'
end /* Do */
else do
if tint=1 & tssp=0 then
noint='checked'
else
nossp='checked'
end /* Do */
stuff=a_replacestrg(stuff,'$NO_SSP_INT',noint,'ALL') /* careful, kind of confusing! */
stuff=a_replacestrg(stuff,'$NO_SSP_YES',nossp,'ALL')
stuff=a_replacestrg(stuff,'$NO_SSP_NO',okssp,'ALL')
ok=make_doc(theopt,0,'MISC')
end
when theopt='FIX_EXPIRE' then do
ok=get_it('fixexpir')
foo=get_value('FIX_EXPIRE')
isyes=' ' ; isno='checked '
if datatype(foo)="NUM" then do
if foo>0 then do
isyes='checked' ; isno=' '
end /* Do */
end /* Do */
stuff=a_replacestrg(stuff,'$ISYES',isyes,'ALL')
stuff=a_replacestrg(stuff,'$ISNO',isno,'ALL')
ok=make_doc(theopt,0,'MISC')
end
when theopt='SMTP_GATEWAY' then do
ok=get_it('SMTP')
hm=get_value('SMTP_GATEWAY')
stuff=a_replacestrg(stuff,'$SMTP_GATEWAY',hm,'ALL')
ok=make_doc(theopt,0,'MISC')
end
otherwise do
'STRING NO SUCH Option= ' theopt
ok='200 25'
end
end /* select */
return ok
/********************************************/
responsecf:procedure
parse arg request,atext,stuff
select
when request='badreq' then use='400 Bad request syntax'
when request='notfound' then use='404 Not found'
when request='forbid' then use='403 Forbidden'
when request='unauth' then use='401 Unauthorized'
when request='notallowed' then use='405 Method not allowed'
when request='notimplemented' then use='501 Not implemented'
otherwise do
use='406 Not acceptable'
call pmprintf('weird response '|| request||' '|| message)
end
end /* Add others to this list as needed */
/* Now set the response and build the response file */
'RESPONSE HTTP/1.0' use /* Set HTTP response line */
parse var use code text
if request='notallowed' then do
'HEADER ADD Allow:HEAD '
end
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>"text"</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
select
when request='unauth' then do
'header add WWW-Authenticate: Basic Realm=<'atext'>' /* challenge */
if stuff=' ' then
call lineout tempfile,' You are not authorized to visit this area of the bulletin board '
else
call lineout tempfile,' You must supply a Username if you wish to use this Configurator '
end
when request='notfound' then
call lineout tempfile,' File is unavailable: ' stuff
when requeset='forbidden' then
call lineout tempfile,' Configurator is unavailable.'
otherwise
call lineout tempfile,' Request denied: ' stuff
end
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end
return ' '
/******************/
/* READ appropriate file from config_dir directory. Return as a big string */
get_it:procedure expose thedir stuff verbose
parse arg thefile
stuff=' '
afile=thedir||'\'||thefile||'.CNF'
aa=stream(afile,'c','query exists')
if aa=' ' then do
if verbose>1 then say " Missing configuration file: " afile
return 0
end
stuff=charin(aa,1,chars(aa))
stuff=strip(stuff,'t','1a'x)
aa=stream(aa,'c','close')
return 1
/******************/
/* replace isyes and isno in stuff */
do_yesno:procedure expose stuff servername host_nickname enmadd
parse upper arg param,def, yeses,nos
if yeses=' ' then yeses='Y YES 1'
if nos=' ' then nos='N NO 0 '
got1=0
isit=upper(get_value(param))
agin:
if wordpos(isit,yeses)>0 then do
isyes='CHECKED' ; isno=' ' ;got1=1
end
if wordpos(isit,nos)>0 then do
isyes=' ' ; isno='CHECKED';got1=1
end
if got1=0 then do
got1=1
isit=def
signal agin
end /* Do */
stuff=a_replacestrg(stuff,'$ISYES',isyes,'ALL')
stuff=a_replacestrg(stuff,'$ISNO',isno,'ALL')
return 1
/******************/
/* take modified template, make into legit html document, and return */
make_doc:procedure expose stuff tempfile servername host_nickname usecolor
parse arg theopt,NOHOST,jumpto
crlf='0d0a'x
cc='<br><a href="/config0.htm#'jumpto'"><B>CANCEL</B> </a><br>'||crlf
cc=cc||'<A NAME="info"> <br> <!-- jump here for help --></A>'||crlf
stuff=a_replacestrg(stuff,'$CANCEL',cc,'ALL')
v1='<!doctype html public "-//IETF//DTD HTML 2.0//EN">'||crlf
v1=v1||"<html><head><title> SRE-Filter configurator: "theopt"</title></head>"||crlf
v1=v1||'<BODY bgcolor="#'||usecolor||'">'||crlf
j1='<A HREF="#info">Notes, hints, and examples</A> '||crlf
if host_nickname<>' ' & NOHOST<>1 then do
j1=j1||' ..... Modifying parameters for the <b>' host_nickname '</b> <em> host</em>'||crlf
end /* Do */
j1=j1||'<br> <A NAME="setparam"> </A>'||crlf
v1=v1||j1||stuff||crlf
j2='<br><A HREF="#setparam">Return to parameter modification screen</A>'||crlf
v1=v1||j2||'<hr>'||crlf
v1=v1||'<a href="/config0.htm">Cancel and return to Simple Configurator Introduction </a>'||crlf
v1=v1||'<p><em> From server at: '||servername||'</em>'||crlf
v1=v1||'</body></html>'
'VAR TYPE text/html NAME v1 '
return '200 '||length(v1)
/* ----------- */
/* get environment value, possibly host specific
hname=0 -- do not look under hostname
hname=1 -- do not look under default
*/
/* ------------ */
get_value: procedure expose enmadd host_nickname
parse upper arg vname,hname0
if hname0=0 then
hname=' '
else
hname=strip(host_nickname)
vname=strip(vname) ;
if hname<>' ' then do
booger=strip(enmadd||vname||'.'||hname)
aval=value(booger,,'os2environment')
if aval<>' ' | hname0=1 Then
return aval
end
aval=value(enmadd||vname,,'os2environment')
return aval
/**************************/
/* check for legitimacy of the client */
okay_client: /* subroutine. set the notokay variable */
rstatus=' '
who2=extract('CLIENTADDR')
saddr2=extract('SERVERADDR')
select
when checkit=1 then do
/* only if user = serveraddress !!! */
if who2<>saddr2 then do /* auto entry if sitting at server and checkit=1 */
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 3.0//EN">'
call lineout tempfile, "<html><head><title>SREFILTER ERROR </title>"
call lineout tempfile, "</head><body>"
call lineout tempfile,' <strong> The Simple Configurator can not be run remotely.</strong> '
call lineout tempfile,' </body> </html> '
call lineout tempfile
'FILE ERASE TYPE text/html NAME' tempfile
notokay=1
return 1
end
end
otherwise do /* checkit=0 */
if wordpos('SUPERUSER',upper(privset))=0 then do
aa=responsecf('unauth','configure','SUPERUSER privileges required for remote configuration')
rstatus='401 0'
notokay=1
return 1
end
end
end
notokay=0
return 0
/************************/
/* remove entries from a paramter file */
change_file:procedure expose host_nickname enmadd tempfile mess2
parse arg thingie, newval,remlist,noupdate,nocvt,nohost
newval0=newval
lookfor=get_value(thingie) /* the file to change */
if lookfor=' ' then return " Could not find: " thingie
foo=fileread(lookfor,dalines,,'E')
if dalines.0=0 then return 'Could not read:'||lookfor
/* scan through, looking for parameters that match:
if in remlist, remove. If = newval, remove and replace.
If no match, and newval<>' ', put newval at the end
*/
remlist=strip(upper(translate(remlist,'/','\')))
remlist=strip(remlist,,'/')
newval=strip(upper(translate(newval,'/','\')))
newval=strip(newval,,'/')
inew=0
ninh=0
nkill=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if abbrev(aline,';')=1 | aline=' ' then do /*retain comments */
inew=inew+1
newlines.inew=dalines.mm
iterate
end
if nohost<>1 then do
if wordpos('//',aline)=2 | right(strip(word(aline,1)),2)='//' then do /* host specific, does it match ? */
parse var aline ahost '//' aline
if strip(ahost)<>host_nickname then do /* no match, retain */
inew=inew+1
newlines.inew=dalines.mm
iterate
end /* Do */
end /* Do */
else do /* generic== skip if host-Nickname is active */
if host_nickname<>' ' then do
inew=inew+1
newlines.inew=dalines.mm
iterate
end /* Do */
end
end /* nohost -- so don't worry about host stuff */
/* if here, generic or host-matches. Is it in remlist */
if (nohost<>1) & ,
(wordpos('//',aline)=2 | right(strip(word(aline,1)),2)='//') then /* host specific, does it match ? */
parse var aline . '//' aentry .
else
parse var aline aentry .
if remlist<>' ' then do
use1=upper(strip(word(aentry,1)))
aentry=strip(translate(aentry,'/','\'),,'/')
if wordpos(aentry,remlist)>0 then do /* skip this one */
nkill=nkill+1
iterate
end /* Do */
end /* Do */
/*is it the newval? */
newval1=strip(word(newval,1))
if newval1=aentry then iterate /* don't copy -- will redo */
inew=inew+1 /* keep */
newlines.inew=dalines.mm
end
if newval<>' ' then do /* add the new one */
inew=inew+1
newval=newval0
if abbrev(strip(newval0),'*')=1 then
newval='/'||strip(newval0)
if nocvt=1 then newval=translate(newval,'\','/')
if host_nickname<>' ' then
newlines.inew=host_nickname||' // '||newval
else
newlines.inew=newval
end
if noupdate<>1 then do
bakfile=lookfor /* create a .bak file */
foo=lastpos('.',bakfile)
if foo=0 then
bakfile=bakfile||'.bak'
else
bakfile=delstr(bakfile,foo)||'.bak'
wow=doscopy(STRIP(LOOKFOR),STRIP(bakfile),'R')
if wow<>0 then do
say " ERROR: backup copy could not be made, error code " wow
return 'Backup copy could not be made'
end /* Do */
end
NEWLINES.0=INEW
/* now write new results */
foo=filewrite(lookfor,newlines,'R')
if foo=0 then return 'Could not save parameters file '
mess2=' Number entries deleted: '||nkill
return 1 /* success */
/************************/
/* extract entries from a paramter file */
make_users:procedure expose host_nickname enmadd tempfile stuff2
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process USERNAME file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
ngot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if abbrev(aline,';')=1 | aline=' ' then iterate /* just a comment */
if wordpos('//',aline)=2 | right(strip(word(aline,1)),2)='//' then do /* host specific, does it match ? */
parse var aline ahost '//' aline
if strip(ahost)<>host_nickname then iterate
end /* Do */
else do /* generic== skip if host-Nickname is active */
if host_nickname<>' ' then iterate
end
/* got a match, extract username */
ngot=ngot+1
parse var aline users.ngot .
end /* do */
if ngot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No users in username database</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no user entries (for the ' host_nickname ' Host) in the user database: ' afile
else
call lineout tempfile,' <b>There are no user entries in the user database: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em>.<br>'
aa.3='<ol> '
do mm=1 to ngot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||users.mm||'" > <b> '||users.mm||'</b>'
end /* do */
fee=3+ngot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||ngot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from a paramter file */
make_access:procedure expose host_nickname enmadd tempfile stuff2
parse arg thingie,getdef
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process Access Control file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
ngot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if abbrev(aline,';')=1 | aline=' ' then iterate /* just a comment */
if abbrev(aline,'!')=1 then iterate /* don't do realm entries */
if wordpos('//',aline)=2 | right(strip(word(aline,1)),2)='//' then do /* host specific, does it match ? */
parse var aline ahost '//' aline
if strip(ahost)<>host_nickname then iterate
end /* Do */
else do /* generic== skip if host-Nickname is active */
if host_nickname<>' ' then iterate
end
/* got a match, extract access control entyr */
parse var aline pepsi pop ; pepsi=strip(pepsi)
parse var pop privs ',' .
if pepsi='*' | pepsi=='/*' | pepsi='\*' then do
if getdef=1 then do /* looking for default, are we? */
stuff2=privs
return strip(stuff2)
end /* Do */
iterate /* else, ignore */
end /* Do */
ngot=ngot+1
users.ngot=pepsi
privs=strip(space(privs))
if length(privs)>50 then privs=left(privs,45)||' ...'
users.ngot.2=privs
end /* do */
if getdef=1 then do
stuff2=' '
return 1
end
if ngot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No entries in the access control </title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no entries (for the ' host_nickname ' Host) in the access control file: ' afile
else
call lineout tempfile,' <b>There are no entries in the access control file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em> <code>(first 45 characters of privilege list are displayed)</code> <br>'
aa.3='<ol> '
do mm=1 to ngot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||users.mm||'" > <b> '||users.mm||'</b> <code>(privs= 'users.mm.2 '</code>'
end /* do */
fee=3+ngot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||ngot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from a initfilt.80 parameter file */
make_inhouseips:procedure expose host_nickname enmadd tempfile stuff2
crlf='0d0a'x
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process initialization file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* read initfilt.80 file, look for inhousesips entries */
igot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if aline=' ' | abbrev(aline,';')=1 then iterate
if abbrev(aline,'INHOUSEIPS.')=0 then iterate
parse var aline p1 '=' p2 ; p2=strip(p2)
p2=strip(p2,,"'"); p2=strip(p2,,'"') ;p2=strip(p2)
if p2=' ' | p2=0 then iterate
p1=translate(p1,' ','.')
if words(p1)=1 then iterate /* error, ignore */
if words(p1)=2 & host_nickname=' ' then do
igot=igot+1
gotinh.igot=word(strip(p2),1)
end /* Do */
if words(p1)=3 then do /* 3rd is host nickmane */
if strip(word(p1,3))=host_nickname then do
igot=igot+1
gotinh.igot=word(strip(p2),1)
end /* Do */
end /* do */
end /* do */
if igot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No In-House Entries</title></head>"
call lineout tempfile, "<body><h2>Nothing to do!</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no In-house entries (for the ' host_nickname ' Host '
else
call lineout tempfile,' <b>There are no In-house entries'
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em>.<br>'
aa.3='<ol> '
do mm=1 to igot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||gotinh.mm||'" > <b> '||gotinh.mm||'</b>'
end /* do */
fee=3+igot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||igot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from a initfilt.80 parameter file */
make_puburls:procedure expose host_nickname enmadd tempfile stuff2
crlf='0d0a'x
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process initialization file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* read initfilt.80 file, look for public_urls. entries */
igot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if aline=' ' | abbrev(aline,';')=1 then iterate
if abbrev(aline,'PUBLIC_URLS.')=0 then iterate
parse var aline p1 '=' p2 ; p2=strip(p2)
p2=strip(p2,,"'"); p2=strip(p2,,'"') ;p2=strip(p2)
if p2=' ' | p2=0 then iterate
p1=translate(p1,' ','.')
if words(p1)=1 then iterate /* error, ignore */
if words(p1)=2 & host_nickname=' ' then do
igot=igot+1
gotinh.igot=word(strip(p2),1)
end /* Do */
if words(p1)=3 then do /* 3rd is host nickmane */
if strip(word(p1,3))=host_nickname then do
igot=igot+1
gotinh.igot=word(strip(p2),1)
end /* Do */
end /* do */
end /* do */
if igot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No PUBLIC area identifiers</title></head>"
call lineout tempfile, "<body><h2>Nothing to do!</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no PUBLIC area PUBLIC area identifiters (for the ' host_nickname ' Host '
else
call lineout tempfile,' <b>There are no PUBLIC area identifiers '
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em>.<br>'
aa.3='<ol> '
do mm=1 to igot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||gotinh.mm||'" > <b> '||gotinh.mm||'</b>'
end /* do */
fee=3+igot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||igot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from a initfilt.80 parameter file */
make_hosts:procedure expose host_nickname enmadd tempfile stuff2
crlf='0d0a'x
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process initialization file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* read initfilt.80 file, look for host entries */
igot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if aline=' ' | abbrev(aline,';')=1 then iterate
if abbrev(aline,'HOSTS.')=0 then iterate
parse var aline p1 '=' p2 ;
p2=translate(p2,' ',"'"||'"') ; p2=strip(p2)
if p2=0 then iterate
parse var p2 anip ',' anick ',' .
igot=igot+1
ahosts.igot=strip(upper(anip))
ahosts.igot.2=strip(upper(anick))
end /* do */
if igot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No HOST definitions</title></head>"
call lineout tempfile, "<body><h2>Nothing to do!</h2>"
call lineout tempfile,' <b>There are no host definitions'
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em>.<br>'
aa.3='<ol> '
do mm=1 to igot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||ahosts.mm||'" > '||ahosts.mm||'(with host nickname of <b> ' ahosts.mm.2 '</b>)'
end /* do */
fee=3+igot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||igot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from a virtual dir file */
make_virtual:procedure expose host_nickname enmadd tempfile stuff2
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process virtual directory file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
ngot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if abbrev(aline,';')=1 | aline=' ' then iterate /* just a comment */
if wordpos('//',aline)=2 | right(strip(word(aline,1)),2)='//' then do /* host specific, does it match ? */
parse var aline ahost '//' aline
if strip(ahost)<>host_nickname then iterate
end /* Do */
else do /* generic== skip if host-Nickname is active */
if host_nickname<>' ' then iterate
end
/* got a match, extract virtual dir */
ngot=ngot+1
parse var aline wow thedir
users.ngot=strip(translate(wow,'/','\'),,'/')||'/'
thedir=strip(translate(thedir,' ','*'))
users.ngot.2=thedir
end /* do */
if ngot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No entries in virtual directory list</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no virtual directory entries (for the ' host_nickname ' Host) in: ' afile
else
call lineout tempfile,' <b>There are no virtual directory entries in: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em>.<br>'
aa.3='<ol> '
do mm=1 to ngot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||users.mm||'" > <b> '||users.mm||'</b> (... maps to:<tt> ' users.mm.2 '</tt>)'
end /* do */
fee=3+ngot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||ngot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from an alias file */
make_alias:procedure expose host_nickname enmadd tempfile stuff2
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process redirection aliases file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
ngot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if abbrev(aline,';')=1 | aline=' ' then iterate /* just a comment */
if wordpos('//',aline)=2 | right(strip(word(aline,1)),2)='//' then do /* host specific, does it match ? */
parse var aline ahost '//' aline
if strip(ahost)<>host_nickname then iterate
end /* Do */
else do /* generic== skip if host-Nickname is active */
if host_nickname<>' ' then iterate
end
/* got a match, extract alias */
parse var aline wow whereto
foo2=upper(whereto)
jump=pos('HTTP://',foo2)+ pos('!MOVED',foo2) + pos('!TEMP',foo2)
if jump=0 then iterate /* remote redirection only */
ngot=ngot+1
wow=strip(wow); if right(wow,1)<>'*' then
users.ngot=strip(translate(wow,'/','\'),,'/')||'/'
else
users.ngot=wow
whereto=strip(whereto)
if length(whereto)>60 then whereto=left(whereto,55)||' ...'
users.ngot.2=whereto
end /* do */
if ngot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No entries in redirection alias list</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no redirection aliases entries (for the ' host_nickname' Host) in: ' afile
else
call lineout tempfile,' <b>There are no redirection aliases entries in: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained</em> (<code> The first 55 characters are displayed. </code>) <br>'
aa.3='<ol> '
do mm=1 to ngot
jj=' (<em> redirecting to:' users.mm.2 '</em>)'
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||users.mm||'" > <b> '||users.mm||'</b> (redirect to:<tt> ' users.mm.2 '</tt>'
end /* do */
fee=3+ngot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||ngot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
/************************/
/* extract entries from a replacement strings file */
make_custom:procedure expose host_nickname enmadd tempfile stuff2
parse arg thingie
crlf='0d0a'x
afile=get_value(thingie)
foo=fileread(afile,dalines,,'E')
if dalines.0=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Problem with SRE-Filter configurator</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
call lineout tempfile,' <b>Error</b>: could not process replacement strings file: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
ngot=0
do mm=1 to dalines.0
aline=upper(strip(dalines.mm))
if aline=" " | abbrev(aline,';')=1 then iterate
parse var aline p1 p2
p1=translate(p1,' ','.')
if words(p1)=1 & host_nickname<>' ' then iterate
oo=word(p1,words(p1))
if words(p1)>1 then do
if datatype(oo)<>'NUM' then
if upper(strip(oo))<>host_nickname then iterate
end /* Do */
p10=p1 ;
if words(p1)>1 & datatype(oo)<>'NUM' then
p10=delword(p10,words(p10))
ngot=ngot+1
p2=a_replacestrg(p2,'<','<','ALL')
p2=a_replacestrg(p2,'>','>','ALL')
p2=a_replacestrg(p2,'"','"','ALL')
users.ngot=translate(strip(p10),'.',' ')
if length(p2)>60 then p2=left(p2,55)||' ...'
users.ngot.2=left(p2,70)
end /* do */
if ngot=0 then do
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>No entries in replacement strings list</title></head>"
call lineout tempfile, "<body><h2>Sorry...</h2>"
if host_nickname<>' ' then
call lineout tempfile,' <b>There are no replacement strings (for the ' host_nickname' Host) in: ' afile
else
call lineout tempfile,' <b>There are no replacement strings in: ' afile
call lineout tempfile, "</body></html>"
call lineout tempfile /* close */
'FILE ERASE TYPE text/html NAME ' tempfile
return 0
end /* Do */
/* now create a list */
aa.1='<h2> Select Entries to Remove </h2> '
aa.2='<em>Unchecked entries will be retained <code>(the first 55 characters are displayed)</code></em>.<br>'
aa.3='<ol> '
do mm=1 to ngot
fee=3+mm
aa.fee='<li> <INPUT TYPE="CHECKBOX" NAME="delete.'||mm||'" VALUE="'||users.mm||'" > <b> '||users.mm||'</b> (<code> == ' users.mm.2 '</code>'
end /* do */
fee=3+ngot+1
aa.fee='</ol>'
fee=fee+1
aa.fee='<INPUT TYPE="hidden" NAME="entries" VALUE="'||ngot||'" >'
stuff2=aa.1
do mm=2 to fee
stuff2=stuff2||crlf||aa.mm
end
return 1
* ----------------------------------------------------------------------- */
/* REPLACESTRG:
Arguments:
astring : the "haystack" to look in
target: the "needle" to look for
putme: the "new needle" to replace the "needle" with
type : The direction/type of search
FORWARD, BACKWARD, ALL
exact: YES-- then cases in needle and haystack must match
Note taht regardless of value of exact, cases are retained in both
astring and putme.
Returns the modified astring, or the unmodified astring if target could
not be found.
*/
/* ----------------------------------------------------------------------- */
a_replacestrg:
exactmatch=0
backward=0 ; doall=0
parse arg astring , target , putme , type , exactmatch
type = translate(type)
if type="BACKWARD" then backward="YES"
if type="ALL" then doall="YES"
iat=1
joelen=length(target)
joelen2=length(putme)
doagain: /* here if doall=yes */
if exactmatch="YES" then do
if backward="YES" then
joe= lastpos(target,astring)
else
joe= pos(target,astring,iat)
end
else do
if backward="YES" then
joe= lastpos(translate(target),translate(astring))
else
joe= pos(translate(target),translate(astring),iat)
end
if joe=0 then
return astring
astring=delstr(astring,joe,joelen)
if putme<>' ' then
astring=insert(putme,astring,joe-1)
if doall="YES" then do
iat=joe+joelen2
signal doagain
end
/* else, all done */
return astring
